home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD81137242000.psc / Projetos Visual Basic / VBInsideControls / TitleBanner / TitleBanner.ctl < prev   
Encoding:
Text File  |  2000-07-25  |  11.1 KB  |  288 lines
  1. VERSION 5.00
  2. Begin VB.UserControl TitleBanner 
  3.    Alignable       =   -1  'True
  4.    AutoRedraw      =   -1  'True
  5.    BackColor       =   &H00FFFFFF&
  6.    ClientHeight    =   1110
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   7290
  10.    ScaleHeight     =   1110
  11.    ScaleWidth      =   7290
  12.    Begin VB.Image pctImage 
  13.       Height          =   825
  14.       Left            =   5655
  15.       Top             =   135
  16.       Width           =   1275
  17.    End
  18. End
  19. Attribute VB_Name = "TitleBanner"
  20. Attribute VB_GlobalNameSpace = False
  21. Attribute VB_Creatable = True
  22. Attribute VB_PredeclaredId = False
  23. Attribute VB_Exposed = True
  24. Option Explicit
  25. Private Const LeftDistance As Long = 60
  26. 'Event Declarations:
  27.  
  28. '^''^
  29. ' any comments to laudecioliveira@hotmail.com
  30. Private mCaption As String
  31. Private Const m_def_caption = "TopBar Caption"
  32.  
  33. Private mCaptionColor As OLE_COLOR
  34. Private Const m_def_caption_color = vbBlack
  35.  
  36. Private mCaptionFont As New StdFont
  37.  
  38. Private mDescription As String
  39. Private Const m_def_Description = "TopBar Description"
  40.  
  41. Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
  42. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
  43. Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick
  44. Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
  45. Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown
  46. Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
  47. Event KeyPress(KeyAscii As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyPress
  48. Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
  49. Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
  50. Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
  51. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
  52. Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
  53. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
  54. Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
  55. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
  56. Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
  57.  
  58.  
  59.  
  60. Private Sub Draw3dLine()
  61.     Dim r As RECT   ' Used by DrawEdge to determine where to draw.
  62.     Dim oldColor As OLE_COLOR
  63.     Dim oldFont As Object
  64.     Dim mLeft As Long, mTop As Long
  65.     '-----------------------------------------------------------------
  66.     ' Location of the etched box.
  67.     '-----------------------------------------------------------------
  68.     With r
  69.         .Left = ScaleX(UserControl.ScaleLeft + 10, vbTwips, vbPixels)
  70.         .Top = ScaleX(UserControl.ScaleHeight - 30, vbTwips, vbPixels)
  71.         .Right = ScaleX(UserControl.ScaleWidth - 10, vbTwips, vbPixels)
  72.         .Bottom = ScaleX(UserControl.ScaleHeight, vbTwips, vbPixels)
  73.     End With
  74.     '-----------------------------------------------------------------
  75.     ' Draw it.
  76.     '-----------------------------------------------------------------
  77.     UserControl.Cls
  78.     DrawEdge UserControl.hDC, r, EDGE_ETCHED, BF_RECT
  79.     
  80.     oldColor = UserControl.ForeColor
  81.     Set oldFont = UserControl.Font
  82.  
  83.     
  84.     'set the especified font for the title caption
  85.     UserControl.ForeColor = mCaptionColor
  86.     Set UserControl.Font = mCaptionFont
  87.     
  88.     ' Draw the big caption
  89.     SetRect r, 20, 20, UserControl.ScaleWidth - pctImage.Width, UserControl.TextHeight("X")
  90.     DrawTextEx UserControl.hDC, mCaption, Len(mCaption), r, DT_WORDBREAK, ByVal 0&
  91.     
  92.     'restore the old font and color
  93.     UserControl.ForeColor = oldColor
  94.     Set UserControl.Font = oldFont
  95.     
  96.     ' draw the description
  97.     mLeft = r.Left + 20
  98.     mTop = r.Top + ScaleY(UserControl.TextHeight("X"), vbTwips, vbPixels) + mCaptionFont.Size
  99.     SetRect r, mLeft, mTop, UserControl.ScaleWidth - pctImage.Width, UserControl.TextHeight("X")
  100.     DrawTextEx UserControl.hDC, mDescription, Len(mDescription), r, DT_WORDBREAK, ByVal 0&
  101.  
  102. End Sub
  103.  
  104.  
  105. Private Sub UserControl_InitProperties()
  106.     Set mCaptionFont = Ambient.Font
  107.     mCaptionFont.Bold = True
  108.     mCaptionFont.Size = 10
  109.     
  110.     UserControl.FontName = "Arial"
  111.     UserControl.FontBold = False
  112.     UserControl.FontSize = 8
  113.     mCaption = m_def_caption
  114.     mDescription = m_def_Description
  115.     
  116. End Sub
  117.  
  118. Private Sub UserControl_Resize()
  119.     Draw3dLine
  120.     CenterImage
  121. End Sub
  122.  
  123. Private Sub CenterImage()
  124.     Dim mTop As Single
  125.     Dim mLeft As Single
  126.     ' put the image in the correct place
  127.     mTop = (UserControl.Height - pctImage.Height) / 2
  128.     mLeft = (UserControl.Width - pctImage.Width) - LeftDistance
  129.     pctImage.Move mLeft, mTop
  130. End Sub
  131. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  132. 'MappingInfo=UserControl,UserControl,-1,BackColor
  133. Public Property Get BackColor() As OLE_COLOR
  134. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  135.     BackColor = UserControl.BackColor
  136. End Property
  137.  
  138. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  139.     UserControl.BackColor() = New_BackColor
  140.     PropertyChanged "BackColor"
  141.     UserControl_Resize
  142. End Property
  143.  
  144. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  145. 'MappingInfo=Label1,Label1,-1,ForeColor
  146. Public Property Get ForeColor() As OLE_COLOR
  147. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
  148.     ForeColor = mCaptionColor
  149. End Property
  150.  
  151. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  152.     mCaptionColor = New_ForeColor
  153.     PropertyChanged "ForeColor"
  154.     UserControl_Resize
  155. End Property
  156.  
  157. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  158. 'MappingInfo=UserControl,UserControl,-1,Enabled
  159. Public Property Get Enabled() As Boolean
  160. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  161.     Enabled = UserControl.Enabled
  162. End Property
  163.  
  164. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  165.     UserControl.Enabled() = New_Enabled
  166.     PropertyChanged "Enabled"
  167. End Property
  168.  
  169. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  170. 'MappingInfo=Label1,Label1,-1,Font
  171. Public Property Get Font() As Font
  172. Attribute Font.VB_Description = "Returns a Font object."
  173. Attribute Font.VB_UserMemId = -512
  174.     Set Font = mCaptionFont
  175. End Property
  176.  
  177. Public Property Set Font(ByVal New_Font As Font)
  178.     Set mCaptionFont = New_Font
  179.     PropertyChanged "Font"
  180.     UserControl_Resize
  181. End Property
  182.  
  183. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  184. 'MappingInfo=UserControl,UserControl,-1,Refresh
  185. Public Sub Refresh()
  186. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  187.     UserControl.Refresh
  188. End Sub
  189.  
  190. Private Sub UserControl_Click()
  191.     RaiseEvent Click
  192. End Sub
  193.  
  194. Private Sub UserControl_DblClick()
  195.     RaiseEvent DblClick
  196. End Sub
  197.  
  198. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  199.     RaiseEvent KeyDown(KeyCode, Shift)
  200. End Sub
  201.  
  202. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  203.     RaiseEvent KeyPress(KeyAscii)
  204. End Sub
  205.  
  206. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  207.     RaiseEvent KeyUp(KeyCode, Shift)
  208. End Sub
  209.  
  210. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  211.     RaiseEvent MouseDown(Button, Shift, X, Y)
  212. End Sub
  213.  
  214. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  215.     RaiseEvent MouseMove(Button, Shift, X, Y)
  216. End Sub
  217.  
  218. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  219.     RaiseEvent MouseUp(Button, Shift, X, Y)
  220. End Sub
  221.  
  222. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  223. 'MappingInfo=pctImage,pctImage,-1,Picture
  224. Public Property Get Picture() As Picture
  225. Attribute Picture.VB_Description = "Returns/sets a graphic to be displayed in a control."
  226.     Set Picture = pctImage.Picture
  227. End Property
  228.  
  229. Public Property Set Picture(ByVal New_Picture As Picture)
  230.     Set pctImage.Picture = New_Picture
  231.     PropertyChanged "Picture"
  232.     If UserControl.Height <= pctImage.Height Then
  233.         UserControl.Height = (pctImage.Height + (LeftDistance * 2))
  234.     Else
  235.         UserControl_Resize
  236.     End If
  237. End Property
  238.  
  239. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  240. 'MappingInfo=Label1,Label1,-1,Caption
  241. Public Property Get CaptionTitle() As String
  242. Attribute CaptionTitle.VB_Description = "Returns/sets the text displayed in an object's title bar or below an object's icon."
  243.     CaptionTitle = mCaption
  244. End Property
  245.  
  246. Public Property Let CaptionTitle(ByVal New_CaptionTitle As String)
  247.     mCaption = New_CaptionTitle
  248.     PropertyChanged "CaptionTitle"
  249.     UserControl_Resize
  250. End Property
  251.  
  252. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  253. 'MappingInfo=Label2,Label2,-1,Caption
  254. Public Property Get CaptionDescription() As String
  255. Attribute CaptionDescription.VB_Description = "Returns/sets the text displayed in an object's title bar or below an object's icon."
  256.     CaptionDescription = mDescription
  257. End Property
  258.  
  259. Public Property Let CaptionDescription(ByVal New_CaptionDescription As String)
  260.     mDescription = New_CaptionDescription
  261.     PropertyChanged "CaptionDescription"
  262.     UserControl_Resize
  263. End Property
  264.  
  265. 'Load property values from storage
  266. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  267.     UserControl.BackColor = PropBag.ReadProperty("BackColor", &HFFFFFF)
  268.     mCaptionColor = PropBag.ReadProperty("ForeColor", &H80000012)
  269.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  270.     Set mCaptionFont = PropBag.ReadProperty("Font", Ambient.Font)
  271.     Set Picture = PropBag.ReadProperty("Picture", Nothing)
  272.     mCaption = PropBag.ReadProperty("CaptionTitle", "Put your title here:")
  273.     mDescription = PropBag.ReadProperty("CaptionDescription", "Put your description here:")
  274.     Debug.Print "ReadProperty"
  275. End Sub
  276.  
  277. 'Write property values to storage
  278. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  279.     Call PropBag.WriteProperty("BackColor", UserControl.BackColor, vbWhite)
  280.     Call PropBag.WriteProperty("ForeColor", mCaptionColor, vbBlack)
  281.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  282.     Call PropBag.WriteProperty("Font", mCaptionFont, Ambient.Font)
  283.     Call PropBag.WriteProperty("Picture", Picture, Nothing)
  284.     Call PropBag.WriteProperty("CaptionTitle", mCaption, "Put your title here:")
  285.     Call PropBag.WriteProperty("CaptionDescription", mDescription, "Put your description here:")
  286. End Sub
  287.  
  288.